home *** CD-ROM | disk | FTP | other *** search
- unit RFMain;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, Registry, ComCtrls, IniFiles;
-
- type
- TForm1 = class(TForm)
- AssociationList: TListBox;
- FileTypesLabel: TLabel;
- HeaderControl1: THeaderControl;
- Backup: TButton;
- SaveDialog: TSaveDialog;
- Restore: TButton;
- OpenDialog: TOpenDialog;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure AssociationListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
- procedure HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
- procedure HeaderControl1SectionClick(HeaderControl: THeaderControl; Section: THeaderSection);
- procedure AssociationListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure BackupClick(Sender: TObject);
- procedure RestoreClick(Sender: TObject);
- procedure AssociationListDblClick(Sender: TObject);
- private
- { Private declarations }
- SysReg: TRegIniFile; { For accessing system registry }
- ShowDesc: Boolean; { True for descriptions, False for associations }
- HeaderZeroSize: Integer; { A little hackette for on-the-fly header resizing }
- function GetStr (S: String; Idx: Integer): String;
- procedure DeleteItem (const ItemString: String);
- procedure RestoreAssociation (IniFile: TIniFile; const Extension: String);
- procedure PutAssociation (const Str: String);
- procedure LoadAssociations;
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- uses EditAssoc;
-
- const
- Delimiter = '|';
-
- // The following constants make it easier to use GetStr
-
- gs_Extension = 0; // Extension of filename
- gs_Lev2Name = 1; // Name of second level reg key
- gs_Descrip = 2; // Plain-English description
- gs_Command = 3; // Command string
- gs_DDE = 4; // DDE string
-
- function TForm1.GetStr (S: String; Idx: Integer): String;
- var
- IdxPos: Integer;
- begin
- while Idx <> 0 do begin
- IdxPos := Pos (Delimiter, S);
- S := Copy (S, IdxPos + 1, MaxInt);
- Dec (Idx);
- end;
-
- IdxPos := Pos (Delimiter, S);
- if IdxPos = 0 then IdxPos := MaxInt;
- Result := Copy (S, 1, IdxPos - 1);
- end;
-
- procedure TForm1.LoadAssociations;
- var
- Idx: Integer;
- SubKeys, FileExts: TStringList;
- Str, Desc, Cmd, CurSubKeyName: String;
- Data: String;
- begin
- AssociationList.Items.Clear;
-
- { Create a temporary stringlist for holding raw subkey names }
- SubKeys := TStringList.Create;
-
- { And another for holding tab-delimited file extensions }
- FileExts := TStringList.Create;
- try
- SysReg.ReadSections (SubKeys);
- for Idx := SubKeys.Count - 1 downto 0 do begin
- CurSubKeyName := SubKeys [Idx];
- if CurSubKeyName [1] = '.' then begin
- Data := CurSubKeyName + Delimiter;
- Str := SysReg.ReadString (CurSubKeyName, '', '');
- if Str <> '' then begin
- Data := Data + Str + Delimiter;
- Desc := SysReg.ReadString (Str, '', '');
- if Desc <> '' then begin
- Data := Data + Desc + Delimiter;
- Cmd := SysReg.ReadString (Str + '\shell\open\command', '', '');
- if Cmd <> '' then begin
- Data := Data + Cmd + Delimiter;
- if SysReg.KeyExists (Str + '\shell\open\ddeexec') then
- Data := Data + 'Y'
- else
- Data := Data + 'N';
- FileExts.Add (Data);
- end;
- end;
- end;
- end;
- end;
-
- AssociationList.Items.Assign (FileExts);
- AssociationList.ItemIndex := 0;
- FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
- finally
- SubKeys.Free;
- FileExts.Free;
- end;
- end;
-
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- { Open the registry and access the hKey_Classes_Root hive }
- SysReg := TRegIniFile.Create ('');
- SysReg.RootKey := hKey_Classes_Root;
- SysReg.OpenKey ('', False);
- LoadAssociations;
- ShowDesc := True;
- HeaderZeroSize := HeaderControl1.Sections [0].Width;
- end;
-
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- SysReg.Free;
- end;
-
- procedure TForm1.AssociationListDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
- var
- Idx: Integer;
- ItemString: String;
- begin
- with AssociationList.Canvas do begin
- FillRect (Rect);
- if odSelected in State then Font.Style := Font.Style + [fsBold];
-
- ItemString := AssociationList.Items [Index];
- TextOut (Rect.Left + 5, Rect.Top, GetStr (ItemString, gs_Extension));
- if ShowDesc then Idx := gs_Descrip else Idx := gs_Command;
- TextOut (HeaderZeroSize, Rect.Top, GetStr (ItemString, Idx));
- end;
- end;
-
- procedure TForm1.HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
- begin
- if State = tsTrackMove then begin
- HeaderZeroSize := Width;
- AssociationList.Invalidate;
- end;
- end;
-
- procedure TForm1.HeaderControl1SectionClick (HeaderControl: THeaderControl; Section: THeaderSection);
- begin
- if Section = HeaderControl1.Sections [1] then begin
- ShowDesc := not ShowDesc;
- if ShowDesc then Section.Text := 'File Description' else Section.Text := 'File Association';
- AssociationList.Invalidate;
- end;
- end;
-
- procedure TForm1.DeleteItem (const ItemString: String);
- begin
- with AssociationList do begin
- Items.Delete (ItemIndex);
- ItemIndex := 0;
- FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
- { Now delete the registry stuff too }
- SysReg.EraseSection (SysReg.ReadString (GetStr (ItemString, gs_Extension), '', ''));
- SysReg.EraseSection (GetStr (ItemString, gs_Extension));
- end;
- end;
-
- procedure TForm1.AssociationListKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
- var
- ItemString: String;
- begin
- if Key = vk_Delete then with AssociationList do begin
- ItemString := Items [ItemIndex];
- if MessageDlg (Format ('Remove all registry entries for ''%s''?',
- [GetStr (ItemString, gs_Extension)]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
- DeleteItem (ItemString);
- end;
- end;
-
- procedure TForm1.BackupClick(Sender: TObject);
- var
- Idx: Integer;
- IniFile: TIniFile;
- ItemString, KeyName: String;
- begin
- if SaveDialog.Execute then begin
- IniFile := TIniFile.Create (SaveDialog.FileName);
- try
- for Idx := 0 to AssociationList.Items.Count - 1 do begin
- ItemString := AssociationList.Items [Idx];
- KeyName := GetStr (ItemString, gs_Extension);
- FileTypesLabel.Caption := Format ('Saving info for %s', [KeyName]);
- IniFile.WriteString ('Associations', KeyName, Copy (ItemString, Length (KeyName) + 2, MaxInt));
- end;
- finally
- FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
- IniFile.Free;
- end;
- end;
- end;
-
- procedure TForm1.RestoreClick(Sender: TObject);
- var
- Idx: Integer;
- cursOld: hCursor;
- IniFile: TIniFile;
- KeyNames: TStringList;
- begin
- if OpenDialog.Execute then begin
- Inifile := TIniFile.Create (OpenDialog.FileName);
- try
- KeyNames := TStringList.Create;
- cursOld := SetCursor (LoadCursor (0, idc_Wait));
- try
- IniFile.ReadSection ('Associations', KeyNames);
- if KeyNames.Count = 0 then ShowMessage ('File is invalid or empty') else begin
- for Idx := 0 to KeyNames.Count - 1 do
- RestoreAssociation (IniFile, KeyNames [Idx]);
- LoadAssociations;
- end;
- finally
- SetCursor (cursOld);
- FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
- KeyNames.Free;
- end;
- finally
- IniFile.Free;
- end;
- end;
- end;
-
- procedure TForm1.PutAssociation (const Str: String);
- var
- Lev2Name: String;
- begin
- // First, write the Level-1 entry
- SysReg.WriteString (GetStr (Str, gs_Extension), '', GetStr (Str, gs_Lev2Name));
- // Next, write the Level-2 description field
- Lev2Name := GetStr (Str, gs_Lev2Name);
- SysReg.WriteString (Lev2Name, '', GetStr (Str, gs_Descrip));
- // Write the Level-2 command field
- SysReg.WriteString (Lev2Name + '\shell\open\command', '', GetStr (Str, gs_Command));
- // Finally, see if we should nuke the DDEEXEC tree.
- if GetStr (Str, gs_DDE) = 'N' then
- if SysReg.KeyExists (Lev2Name + '\shell\open\ddeexec') then
- SysReg.EraseSection (Lev2Name + '\shell\open\ddeexec');
- end;
-
- procedure TForm1.RestoreAssociation (IniFile: TIniFile; const Extension: String);
- var
- Str: String;
- begin
- FileTypesLabel.Caption := Format ('Restoring info for %s', [Extension]);
- Str := Extension + Delimiter + IniFile.ReadString ('Associations', Extension, '');
- // If extension no longer in registry, *DONT* try to restore it
- if SysReg.KeyExists (Extension) then PutAssociation (Str);
- end;
-
- procedure TForm1.AssociationListDblClick(Sender: TObject);
- var
- Str: String;
- Idx: Integer;
- begin
- if AssociationList.ItemIndex <> -1 then
- with TEditAssociation.Create (Application) do try
- Idx := AssociationList.ItemIndex;
- Str := AssociationList.Items [Idx];
- Extension.Caption := Format (Extension.Caption, [GetStr (Str, gs_Extension)]);
- AssocPath.Text := GetStr (Str, gs_Command);
- if ShowModal = mrOK then begin
- // Reassemble item-list box string
- Str := GetStr (Str, gs_Extension) + Delimiter +
- GetStr (Str, gs_Lev2Name) + Delimiter +
- GetStr (Str, gs_Descrip) + Delimiter +
- AssocPath.Text + Delimiter +
- GetStr (Str, gs_DDE);
- // Update the list-box
- AssociationList.Items.Delete (Idx);
- AssociationList.Items.Insert (Idx, Str);
- AssociationList.ItemIndex := Idx;
- AssociationList.Invalidate;
- // And update the registry
- PutAssociation (Str);
- end;
- finally
- Free;
- end;
- end;
-
- end.
-